;;;; simple-checker-game.lisp

(in-package #:gamao-impl)

(defgeneric simple-checker-game-classify-board (board))
(defgeneric simple-checker-game-unclassify-position (game position))
(defgeneric dice-count (position))
(defgeneric checker-position-result (rule checker-position player))

(defclass simple-checker-game ()
  ((simple-checker-game-positions :reader simple-checker-game-positions :initform (make-array 4 :fill-pointer 0))))
   
(defmethod new-dice :after ((game simple-checker-game) die1 die2)
  (when (current-player game)
    (let ((positions (simple-checker-game-positions game)))
      (setf (fill-pointer positions) 1
            (aref positions 0) (simple-checker-game-classify-board game)))))

(defun simple-checker-game-current-position (game)
  (let ((positions (simple-checker-game-positions game)))
    (if (plusp (length positions))
        (aref positions (1- (length positions)))
        nil)))

(defmethod remaining-dice-count ((game simple-checker-game))
  (let ((current-position (simple-checker-game-current-position game)))
    (if current-position
        (dice-count current-position)
        nil)))

(defmethod remaining-die ((game simple-checker-game) n)
  (remaining-die (simple-checker-game-current-position game) n))

(defmethod may-move-checker-p ((game simple-checker-game) player from pips)
  (legal-pmove-p (simple-checker-game-current-position game) player from pips game))

(defmethod move-checker ((game simple-checker-game) player from pips)
  (let* ((current-position (simple-checker-game-current-position game))
         (next-position (play-pmove current-position player from pips game)))
    (vector-push next-position (simple-checker-game-positions game))
    (setf (checkers game) (simple-checker-game-unclassify-position game (simple-checker-game-current-position game))))
  game)

(defmethod may-pick-up-dice-p ((game simple-checker-game) player)
  (and (not (null (die1 game)))
       (zerop (remaining-dice-count game))))

(defmethod undo-move ((game simple-checker-game) player)
  (vector-pop (simple-checker-game-positions game))
  (setf (checkers game) (simple-checker-game-unclassify-position game (simple-checker-game-current-position game)))
  game)

(defmethod may-undo-move-p ((game simple-checker-game) player)
  (if (> (length (simple-checker-game-positions game)) 1)
      (values t nil)
      (values nil 'no-moves-to-undo)))


(defmethod pick-up-dice :after ((game simple-checker-game) player)
  (setf (fill-pointer (simple-checker-game-positions game)) 0))
